1 Ustawienia wstępne

1.1 Wykorzystane biblioteki

library(EDAWR)
library(dplyr)
library(tidyverse)
library(readxl)
library(ggplot2)
library(plotly)
library(reactable)
library(caret)
library(randomForest)

1.2 Zapewnienie powtarzalności obliczeń

set.seed(23)

2 Wczytanie, czyszczenie i podsumowanie zbiorów

2.1 World Development Indicators

2.1.1 Wczytanie danych

dirty_wdi = read_excel("Data/World_Development_Indicators.xlsx", na="..")

Zbiór zawierał komórki o wartościach ‘..’ nie zawierające danych. Zostały one zastąpione wartościami pustymi na etapie wczytywania.

2.1.2 Czyszczenie zbioru

Wyodrębnienie wszystkich serii

series_df <- dirty_wdi %>%
  distinct(`Series Name`, `Series Code`)

series_df %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

Utworzenie tabeli zawierającej tylko kraje i ich wskaźniki rozwoju na przestrzeni lat

country_df <- dirty_wdi %>%
  gather("Year", "Value", 5:ncol(dirty_wdi)) %>% 
  select(-c(`Series Code`)) %>%
  filter(!`Country Name` %in% c("Low & middle income","Low income","Lower middle income","Middle income","Upper middle income","High income"))  %>%
  mutate(Year = as.numeric(substr(Year, 1, 4)))

country_df %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

Dla uproszczenia dalszej analizy, odfiltrowano dane tylko do Niemiec, o rozsądnym współczynnik wypełnienia 65%. Wybrano Niemcy, ponieważ posiadają największy % udziału w PKB Unii Europejskiej.

germany_df <- country_df %>%
  filter(`Country Name` == 'Germany') %>%
  select(-c(`Country Name`,`Country Code`))

germany_df %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

Utworzenie zbioru danych zawierającego wszystkie wskaźniki dla różnych kategorii zamożności, które zostaną wykorzystane w podsumowaniu

group_df <- dirty_wdi %>%
  gather("Year", "Value", 5:ncol(dirty_wdi), na.rm = TRUE) %>% 
  select(-`Series Name`) %>%
  filter(`Country Name` %in% c("Low & middle income","Low income","Lower middle income","Middle income","Upper middle income","High income")) %>%
  mutate(Year = as.numeric(substr(Year, 1, 4)))

group_df %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

2.1.3 Podsumowanie danych

Cały zbiór World Development Indicators zawiera dane o 214 wskaźnikach rozwoju 201 państw od roku 1970 do roku 2020. Oprócz tego zawiera informacje o kategoriach zamożności, których trendy zostały przedstawione poniżej:

group_df %>%
  filter(`Series Code` == "NY.GDP.PCAP.CD") %>%
  ggplot(aes(x=Year, y=Value)) +
  geom_point() +  
  geom_smooth(method = "lm") +
  facet_wrap( ~ `Country Name`) +
  labs(x="Rok", y="Wartość [USD]") +
  ggtitle('PKB na mieszkańca') +
  theme_minimal()

Na podstawie wykresów możemy stwierdzić że wśród krajów niemal każdej z grup widoczna jest tendencja wzrostowa ilości Przychodu Krajowego Brutto na mieszkańca, na przestrzeni danych lat.

2.2 Gold prices

2.2.1 Wczytanie zbioru

Zbiór zawiera informacje o wartości złota wyrażoną w wybranych walutach. Ponieważ w poprzednim zbiorze PKB na mieszkańca był wyrażony w USD, w przypadku wczytywania tego zbioru pozostałe waluty są pomijane.

dirty_gold <- read.csv("Data/Gold prices.csv", colClasses = c("Date", "numeric", "numeric", rep("NULL", 4)), col.names = c("Date", "AM_USD", "PM_USD", rep("NULL", 4)), header = TRUE)

dirty_gold %>% 
  head() %>% 
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

2.2.2 Czyszczenie zbioru danych

Niektóre rekordy posiadają puste komórki w pierwszej lub drugiej połowie dnia. Zostają zastąpione istniejącą już wartością z danego dnia. Dodatkowo zostaną wszystkie dane zostaną pogrupowane po roku oraz dla każdego roku wyliczona ich średnia.

dirty_gold <- dirty_gold %>%
   mutate(AM_USD = coalesce(AM_USD,PM_USD), PM_USD = coalesce(PM_USD,AM_USD))


gold_df <- dirty_gold %>%
  mutate(Year = as.numeric(substr(Date, 1, 4))) %>%
  group_by(Year) %>% 
  summarize(USD = (mean(AM_USD) + mean(PM_USD)) / 2)

gold_df %>% 
  head() %>% 
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

2.2.3 Podsumowanie zbioru

Zbiór zawiera informacje o średniej cenie złota na przestrzeni lat 1968-2021 wyrażonej w USD

gold_df %>%
  ggplot(aes(x=Year, y=USD)) +
  geom_line() + 
  geom_point() +
  geom_smooth(method = "lm") +
  ylim(0, NA) +
  labs(x="Rok", y="Wartość złota [USD]") +
  ggtitle("Wartość złota na przestrzeni lat") +
  theme_minimal()

Na podstawie powyższego wykresu możemy łatwo stwierdzić że złoto znacznie zwiększyła swoją wartość w USD na przestrzeni lat.

2.3 Currency Exchange Rates

2.3.1 Wczytanie danych

currency_df <- read.csv("Data/CurrencyExchangeRates.csv", colClasses = c("Date", rep("numeric", 51)), header = TRUE, na="")

currency_df %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

2.3.2 Czyszczenie danych

Zbiór przedstawia codzienny kurs wymiany 51 walut. Na potrzeby analizy zostaną ograniczone do Chińskich Yuanów, Funtów Brytyjskich, Euro oraz Franków Szwajcarskich. Ponieważ dane są codzienne kursy wymiany walut, zostaną wyliczone średnie dla każdego roku.

currency_df <- currency_df %>%
  select(Date, Chinese.Yuan, U.K..Pound.Sterling, Euro, Swiss.Franc) %>%
  rename(UK.Pound = U.K..Pound.Sterling) %>%
  mutate(Year = as.numeric(format(Date, "%Y"))) %>%
  group_by(Year) %>%
  summarise(Chinese.Yuan = mean(Chinese.Yuan, na.rm = TRUE),
            UK.Pound = mean(UK.Pound, na.rm=TRUE),
            Euro = mean(Euro, na.rm=TRUE),
            Swiss.Franc = mean(Swiss.Franc, na.rm=TRUE))

2.3.3 Podsumowanie danych

currency_df %>%
  rename(Yuan = Chinese.Yuan, Funt = UK.Pound, Frank = Swiss.Franc) %>%
  gather(Currency, Value, Yuan:Frank) %>%
  ggplot(aes(x=Year, y=Value)) +
  geom_point() +
  facet_wrap( ~ Currency) +
  labs(x="Rok", y="Kurs na USD") +
  ggtitle('Kursy wybranych walut na przestrzeni lat') +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))

Na podstawie wykresów możemy zauważyć znaczącą zmianę jedynie w przypadku Chińskich Yuanów. Kurs pozostałych walut na USD pozostaje na podobnym poziomie

2.4 S&P Composites

2.4.1 Wczytanie zbioru

Zbiór zawiera informacje o indeksie S&P (Standard and Poor), czyli powszechne akcje na giełdzie mierzące ogólne wyniki rynku.

sp_composite_df <- read.csv("Data/S&P Composite.csv", colClasses = c("Date", rep("numeric", 9)), header = TRUE, na="")

sp_composite_df %>% 
  head() %>% 
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

2.4.2 Czyszczenie zbioru

Podobnie do zbioru kursów walut, w tym przypadku dane również zostaną pogrupowane po roku oraz zostanie wyliczona ich średnia. Dodatkowo do dalszej analizy odfiltrowane zostają dane sprzed 1995 roku.

sp_composite_df <- sp_composite_df %>%
  mutate(Year = as.numeric(format(Year, format="%Y"))) %>%
  group_by(Year) %>%
  filter(Year >= 1995) %>%
  summarise(S.P.Composite = mean(S.P.Composite))

sp_composite_df %>% 
  head() %>% 
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

2.4.3 Podsumowanie danych

3 Korelacje

Złączenie uzyskanych zbiorów w jeden

germany_df <- germany_df %>%
  spread(`Series Name`, `Value`)

temp_df <- inner_join(germany_df, gold_df) %>%
  rename(GoldUSD = USD)

temp_df <- inner_join(temp_df, currency_df)
sum_df <- inner_join(temp_df, sp_composite_df)

sum_df %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)

Zbiorowa korelacja wszystkich atrybutów

cor_mat <- cor(
  x = select(sum_df, -1), 
  use="pairwise.complete.obs")


cor_df = data.frame(cor_mat) %>%
 rownames_to_column()

cor_df <- cor_df %>%
 pivot_longer(-rowname, names_to="colname")

cor_df %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)
cor_plot <- ggplot(cor_df, aes(colname, rowname, fill=value)) + 
  geom_tile() +
  scale_fill_gradient2() + 
  theme(axis.text.x = element_blank(), axis.text.y = element_blank())

ggplotly(cor_plot)

Wyodrębnienie bardziej interesujących korelacji jest trudne w tak dużym zbiorze, dlatego ze zbioru WDI pozostaną tylko wybrane atrybuty:

Korelacja z mniejszą ilością atrybutów:

cor_mat2 <- cor(
  x = select(filtered_sum_df, -1), 
  use="pairwise.complete.obs")

cor_df2 = data.frame(cor_mat2) %>%
 rownames_to_column() %>%
 pivot_longer(-rowname, names_to="colname")

cor_df2 %>%
  head() %>%
  reactable(resizable=TRUE, wrap=FALSE, bordered=TRUE)
cor_plot2 <- ggplot(cor_df2, aes(colname, rowname, fill=value)) + 
  geom_tile() +
  scale_fill_gradient2() + 
  theme(axis.text.x = element_text(angle=90, hjust=0))

ggplotly(cor_plot2)

Największe korelacje ze współczynnikiem -0.9/0.9 lub większym:

Większość uzyskanych korelacji ma logiczne wytłumaczenie, w miarę rozwoju handlu export oraz import rosną równomiernie, a co za tym idzie społeczeństwo się bogaci, wzrasta również średnia życia. Ciekawą zależnością jest ilość użytkowników internetu do średniej długości życia w momencie urodzenia. Może to wynikać ze zwiększonej świadomości ludzi na temat opieki zdrowotnej. Całkiem odwrotny wpływ na długość życia ma emisja CO2 na mieszkańca. Kolejnym interesującym tematem jest zależność kursu walut (Chińskiego Yuana oraz Franka Szwajcarskiego) do kursu złota, PKB na mieszkańca oraz importu/exportu towarów. Jest to najpewniej spowodowane tym, że atrybuty te są wyrażone w walucie USD, a kursy walut również są zależne od USD.

Najmniejsze korelacje:

Tutaj możemy zauważyć że % populacji posiadającej dostęp do internetu niemal nie zmienia się wraz z jej wzrostem.

4 Animowane wykresy

Wykres populacji kobiet, mężczyzn i całkowitej na świecie na przestrzeni lat

Kolejne wykresy nawiązują już tylko do zredukowanego zbioru z Niemiec. Zmiana wartości złota w stosunku do Yuana w kolejnych latach:

Zmiana procenta populacji korzystającej z internetu w stosunku do PKB na mieszkańca w kolejnych latach. Rozmiar kropki oznacza średnią długość życia:

5 Regresor przewidujący cenę złota

5.1 Podział zbioru

Niestety wybrany wcześniej atrybut o wydatkach na edukację ma zbyt wiele wartości pustych, dlatego do dalszych obliczeń konieczne jest jego odrzucenie.

filtered_sum_df <- filtered_sum_df %>%
  select(-`Gov.expenditure.on.education.USD`)

Pozostaje jeszcze tylko usunięcie wierszy zawierających wartości puste i usunięcie kolumny z rokiem.

filtered_sum_df <- filtered_sum_df[complete.cases(filtered_sum_df), ]

prediction_df <- filtered_sum_df %>%
  select(-`Year`)

inTraining  <- createDataPartition( y = prediction_df$GoldUSD, p=0.7, list=F)
training <- prediction_df[ inTraining,]
testing <- prediction_df[-inTraining,]

5.2 Uczenie

ctrl <- trainControl(
    method = "repeatedcv",
    number = 2,
    repeats = 5)
fit <- train(
  GoldUSD ~ .,
  data = training,
  method = "rf",
  trControl = ctrl,
  ntree = 30
)
fit
## Random Forest 
## 
## 17 samples
## 12 predictors
## 
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times) 
## Summary of sample sizes: 8, 9, 9, 8, 9, 8, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared   MAE     
##    2    205.8369  0.8933538  172.8400
##    7    189.5922  0.8995342  161.1135
##   12    190.8767  0.9174752  155.2223
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 7.

5.3 Predykcja

prediction <- predict(fit, newdata=testing)
prediction
##         1         2         3         4 
##  307.4017  556.3564 1442.9118 1281.8121

5.4 Wyniki

Udało się w zadowalający sposób zaestymować cenę złota na podstawie danych atrybutów.

6 Analiza ważności atrybutów

gbmImp <- varImp(fit, scale = FALSE)
plot(gbmImp)

Co zaskakujące okazuje się, że najważniejszym atrybutem jest średnia długość życia w momencie narodzin. Niemal o połowę mniejszą ważność ma procent ludności używający internetu, a dopiero kolejnymi czynnikami są handel, emisja CO2, Yuan czy też PKB na mieszkańca.